home *** CD-ROM | disk | FTP | other *** search
/ Amoszine 6 / Amoszine 6 (Disk 2 of 2).adf / extra_source.lha / OTHER_SOURCE / NEW_INPUT.Amos / NEW_INPUT.amosSourceCode
Encoding:
AMOS Source Code  |  1992-02-26  |  3.9 KB  |  188 lines
  1. '
  2. '  NEW INPUT ROUTINES for REAL variables and STRINGS 
  3. '
  4. '
  5. '  Written in 1994 by Christian Mumenthaler  
  6. '
  7. '  These routines are public domain. Use them wherever you want to.
  8. '
  9. '  Contact: Christian Mumenthaler
  10. '           Langgruetstr. 178
  11. '           CH-8047 Zuerich
  12. '           Switzerland
  13. '
  14. '  E-mail:  mumi(at)molbio.ethz.ch 
  15. '
  16. '
  17. If Screen Colour<4 : Screen Open 0,320,200,4,0 : Palette 0,$A40,$FFF : End If 
  18. Locate 1,2
  19. Centre "Example of how to use the routines"
  20. Print 
  21. Cmove ,2
  22. Print "  REAL NUMBER INPUT: ";
  23. Pen 0
  24. Proc R_INPUT[10,0]
  25. Pen 2
  26. Print 
  27. Print " (Your input:";Param#;")"
  28. Print 
  29. Print "  INTEGER NUMBER INPUT: ";
  30. Pen 0
  31. Proc R_INPUT[6,123]
  32. Pen 2
  33. Print 
  34. A=Param#
  35. Print " (Your input:";A;")"
  36. Print 
  37. Print "  STRING INPUT: ";
  38. Pen 0
  39. Proc S_INPUT[12,""]
  40. Pen 2
  41. Print 
  42. Print " (Your input:";Param$;")"
  43. Print 
  44. Print "  STRING INPUT (with default): ";
  45. Pen 0
  46. Proc S_INPUT[6,"Hallo"]
  47. Pen 2
  48. Print 
  49. Print " (Your input:";Param$;")"
  50. End 
  51. '
  52. '
  53. '
  54. Procedure R_INPUT[L,NR#]
  55.    '
  56.    ' INPUT ROUTINE FOR REAL NUMBERS 
  57.    '
  58.    ' L   : Length of field
  59.    ' NR# : Default number  (Ignored if NR#=0) 
  60.    '
  61.    '
  62.    ' This routine accepts only the numbers 0 to 9 and the 
  63.    ' characters "." and "-". (Plus RETURN to end and BACKSPACE to 
  64.    ' delete the last character.)
  65.    ' It is therefore more fool-proof than the normal INPUT command. 
  66.    '
  67.    ' You can also easily change it for INTEGER numbers. 
  68.    '
  69.    '
  70.    ' Routine written in 1994 by Christian Mumenthaler 
  71.    ' This routine is Public Domain. Use it wherever you want to.  
  72.    '
  73.    '
  74.    NA$=""
  75.    If NR#<>0
  76.       NA$=Str$(NR#)
  77.       If Left$(NA$,1)=" "
  78.          NA$=Right$(NA$,Len(NA$)-1)
  79.       End If 
  80.    End If 
  81.    Z=Len(NA$)
  82.    L1=L-Z
  83.    Print NA$+Space$(L1);
  84.    Cmove -L1,0
  85.    Curs On 
  86.    A1=Asc("0") : A2=Asc("9")
  87.    Repeat 
  88.       A$=Inkey$
  89.       A$=Upper$(A$)
  90.       A=Asc(A$)
  91.       If((A>=A1 and A<=A2) or(A$=".") or(A$="-" and Z=0)) and Z<L
  92.          Print A$;
  93.          NA$=NA$+A$
  94.          Inc Z
  95.       End If 
  96.       If A$=Chr$(8) and Z>0
  97.          Z=Z-1
  98.          Cmove -1,0 : Print " "; : Cmove -1,0
  99.          NA$=Left$(NA$,Len(NA$)-1)
  100.       End If 
  101.    Until A$=Chr$(13)
  102.    Curs Off 
  103.    A#=Val(NA$)
  104. End Proc[A#]
  105. Procedure S_INPUT[L,NA$]
  106.    '
  107.    ' INPUT ROUTINE FOR STRINGS
  108.    '
  109.    ' L   : Length of field
  110.    ' NA$ : Default string 
  111.    '
  112.    '
  113.    ' This routine accepts all characters that could make sense  
  114.    ' (ASC code above 31 and not between 128 and 159)
  115.    ' This routine allows some editing as besides BACKSPACE, it
  116.    ' also processes the RIGHT and LEFT cursor keys, the DELETE  
  117.    ' key and the ESC key to reset the default string. 
  118.    '
  119.    ' Routine written in 1994 by Christian Mumenthaler 
  120.    ' This routine is Public Domain. Use it wherever you want to.  
  121.    '
  122.    '
  123.    NA2$=NA$
  124.    XC=X Curs
  125.    YC=Y Curs
  126.    Z=Len(NA$)
  127.    P=Z
  128.    L1=L-Z
  129.    Print NA$+Space$(L1);
  130.    Cmove -L1,0
  131.    Curs On 
  132.    Repeat 
  133.       Multi Wait 
  134.       A$=Inkey$
  135.       ACT=Scancode
  136.       A=Asc(A$)
  137.       If(A>=32 and(A<128 or A>=160)) and Z<L
  138.          NA$=Left$(NA$,P)+A$+Right$(NA$,Z-P)
  139.          NA$=Left$(NA$,L)
  140.          Z=Min(Z+1,L)
  141.          Locate XC,YC
  142.          Print NA$
  143.          Inc P
  144.          Locate XC+P,YC
  145.       End If 
  146.       If A=28 and P<L and P<Z
  147.          Cmove 1,
  148.          Inc P
  149.       End If 
  150.       If A=29 and P>0
  151.          Cmove -1,
  152.          Dec P
  153.       End If 
  154.       '
  155.       ' BACKSPACE
  156.       '
  157.       If A$=Chr$(8) and P>0
  158.          NA$=Left$(NA$,P-1)+Right$(NA$,Z-P)
  159.          Dec Z
  160.          Dec P
  161.          Locate XC,YC
  162.          Print NA$+Space$(L-Len(NA$))
  163.          Locate XC+P,YC
  164.       End If 
  165.       '
  166.       ' DELETE 
  167.       '
  168.       If ACT=70 and Z>0 and P<Z
  169.          NA$=Left$(NA$,P)+Right$(NA$,Z-P-1)
  170.          Dec Z
  171.          Locate XC,YC
  172.          Print NA$+Space$(L-Len(NA$))
  173.          Locate XC+P,YC
  174.       End If 
  175.       '
  176.       ' ESCAPE -> reset to default string  
  177.       '
  178.       If A=27
  179.          NA$=NA2$
  180.          Z=Len(NA$)
  181.          P=Z
  182.          Locate XC,YC
  183.          Print NA$;Space$(L-Z);
  184.          Locate XC+P,YC
  185.       End If 
  186.    Until A$=Chr$(13)
  187.    Curs Off 
  188. End Proc[NA$]